(in-package #:srfi.setagaya)

(export '(cut cute))

(defmacro cut (&body form)
  (let ((form (if (member '<...> form :test #'eq)
		  (if (eq '<...> (car (last form)))
		      `(apply (function ,(car form)) ,@(cdr form))
		      (error "CUT:found garbage in lambda list when expecting a `<...>': ~S" (car (last form))))
		  form))
	(result)
	(gss))
    (dolist (item form `(lambda ,(nreverse gss) ,(nreverse result)))
      (case item
	(<> 
	 (let ((gs (gensym)))
	   (push gs result)
	   (push gs gss)))
	(<...> 
	 (let ((gs (gensym)))
	   (push gs result)
	   (push '&rest gss)
	   (push gs gss)))
	(cut)
	(otherwise
	 (push item result))))))

(defmacro cute (&body form)
  (let ((form (if (member '<...> form :test #'eq)
		  (if (eq '<...> (car (last form)))
		      `(apply (function ,(car form)) ,@(cdr form))
		      (error "CUT:found garbage in lambda list when expecting a `<...>': ~S" (car (last form))))
		  form))
	(result)
	(gss)    
	(binds))
    (dolist (item form `(let ,binds (lambda ,(nreverse gss) ,(nreverse result))))
      (case item
	(<> 
	 (let ((gs (gensym)))
	   (push gs result)
	   (push gs gss)))
	(<...>
	 (let ((gs (gensym)))
	   (push gs result)
	   (push '&rest gss)
	   (push gs gss)))
	(cut)
	(otherwise
	 (if (symbolp item)
	     (push item result)
	     (let ((gs (gensym)))
	       (push `(,gs ,item) binds)
	       (push gs result))))))))


#|(defmacro cut (&body form)
  (let ((form (if (member '<...> form :test #'eq)
		  (if (eq '<...> (car (last form)))
		      `(apply (function ,(car form)) ,@(cdr form))
		      (error "CUT:found garbage in lambda list when expecting a `<...>': ~S" (car (last form))))
		  form)))
    (do ((l form (cdr l))
	 (result)
	 (gss))
	((endp l) `(lambda ,(nreverse gss) ,(nreverse result)))
      (let ((item (car l)))
	(case item
	  (<> (let ((gs (gensym)))
		(push gs result)
		(push gs gss)))
	  (<...> (let ((gs (gensym)))
		   (push gs result)
		   (push '&rest gss)
		   (push gs gss)))
	  (cut)
	  (otherwise
	   (push item result)))))))|#

#|(defmacro cute (&body form)
  (let ((form (if (member '<...> form :test #'eq)
		  (if (eq '<...> (car (last form)))
		      `(apply (function ,(car form)) ,@(cdr form))
		      (error "CUT:found garbage in lambda list when expecting a `<...>': ~S" (car (last form))))
		  form)))
    (do ((l form (cdr l))
	 (result)
	 (gss)
	 (binds))
	((endp l) `(let ,binds (lambda ,(nreverse gss) ,(nreverse result))))
      (let ((item (car l)))
	(case item
	  (<> 
	   (let ((gs (gensym)))
	     (push gs result)
	     (push gs gss)))
	  (<...>
	   (let ((gs (gensym)))
	     (push gs result)
	     (push '&rest gss)
	     (push gs gss)))
	  (cut)
	  (otherwise
	   (if (symbolp item)
	       (push item result)
	       (let ((gs (gensym)))
		 (push `(,gs ,item) binds)
		 (push gs result)))))))))|#

